package Gtk2::HyperTextView;

our $VERSION = '0.02';

use strict;
use Gtk2;
use Gtk2::Gdk::Keysyms;
use Glib::Object::Subclass
	Gtk2::TextView::,
	signals => {
		# new signals
		link_clicked => {
			param_types => [qw/Glib::Scalar/],
		},
		link_enter => {
			param_types => [qw/Glib::Scalar/],
		},
		link_leave => {	},
	 };


sub INIT_INSTANCE {
	my $self = shift;
	
	$self->{regular_cursor}  = Gtk2::Gdk::Cursor->new('xterm');
	$self->{hand_cursor}     = Gtk2::Gdk::Cursor->new('hand2');
	$self->{link_properties} = [foreground => 'blue', underline => 'single'];
	$self->{hovering_over_link} = 0;
	
	$self->signal_connect_after('realize' => sub {
		my ($view) = @_;

		$view->get_window('text')->set_events([ qw(
			pointer-motion-mask
			button-release-mask
			key-press-mask
			exposure-mask
			button-press-mask
			structure-mask
			property-change-mask
			scroll-mask	)]);
		return 0;
	});
	$self->set_wrap_mode('word');
	
	# existing signals
	$self->signal_connect(motion_notify_event => \&on_motion_notify_event);
	$self->signal_connect(visibility_notify_event => \&on_visibility_notify_event);
	$self->signal_connect(button_release_event => \&on_button_release_event);
	$self->signal_connect(key_press_event => \&on_key_press_event);
}

# ####### #
# methods #
# ####### #

=item insert_link_at_iter(start, text, data)

Inserts a piece of text into the buffer, giving it the usual appearance of a
hyperlink in a web browser: blue and underlined. Additionally, attaches some
data on the tag, to make it recognizable as a link. 

=cut

sub insert_link_at_iter {
	my ($self, $iter, $text, $data) = @_;
	$data = $text unless defined $data;
	
	my $tag = $self->_create_link_tag($data);
	$self->get_buffer->insert_with_tags($iter, $text, $tag);
}

sub _create_link_tag {
	my($self, $data) = @_;
	
	my $tag = $self->get_buffer->create_tag(
		undef, @{$self->{link_properties}} );
	$tag->{is_link}   = 1;
	$tag->{link_data} = $data;

	return $tag;
}
	
sub apply_link {
	my ($self, $data, $start, $end) = @_;

	my $tag = $self->_create_link_tag($data);
	$self->get_buffer->apply_tag($tag, $start, $end);
}

=item get_link_at_iter(iter)

Returns link data or undef

=cut

sub get_link_at_iter {
	my ($self, $iter) = @_;
	my ($link_tag) = grep {$_->{is_link}} $iter->get_tags;
	return undef unless $link_tag;
	return $link_tag->{link_data};
}

=item click_if_link_at_cursor

Emits the link_clicked signal if the cursor is above a link

=cut

sub click_if_link_at_cursor {
	my $self = shift;
	my $buffer = $self->get_buffer;
	my $iter = $buffer->get_iter_at_mark($buffer->get_insert);
	$self->click_if_link_at_iter($iter);
}

=item click_if_link_at_iter(iter)
	
Emits the link_clicked signal if iter contains a link

Returns undef or link data

=cut

sub click_if_link_at_iter {
	my ($self, $iter) = @_;

	my ($link_tag) = grep {$_->{is_link}} $iter->get_tags;
	return undef unless $link_tag;

	$self->signal_emit('link_clicked', $link_tag->{link_data});

	return $link_tag->{link_data};
}

=item set_cursor_if_appropriate(x, y)

Looks at all tags covering the position (x, y) in the text view, 
and if one of them is a link, change the cursor to the "hands" 
cursor typically used by web browsers.

If no (x, y) is given the pointer coordinates are used

This method is called on a number of events.

Returns the link data if the cursor is above a link

=cut

sub set_cursor_if_appropriate { # FIXME add default x, y
	my ($self, $x, $y) = @_;
	
	unless (defined $x) {
		($x, $y) = $self->get_pointer;
		($x, $y) = $self->window_to_buffer_coords('widget', $x, $y);
	}
	
	my $iter = $self->get_iter_at_location($x, $y);
	my ($link_tag) = grep {$_->{is_link}} $iter->get_tags;

	my $hovering = $link_tag ? 1 : 0;
	if ($hovering != $self->{hovering_over_link}) {
		$self->{hovering_over_link} = $hovering;
		my $cursor = $hovering
			? $self->{hand_cursor}
			: $self->{regular_cursor} ;
		$self->get_window('text')->set_cursor($cursor);
	}
	
	return $hovering ? $link_tag->{link_data} : undef;
}

# ###### #
# Events #
# ###### #

sub on_motion_notify_event {
	# Update the cursor image if the pointer moved.
	
	my ($self, $event) = @_;

	my ($x, $y) = $event->get_coords;
	   ($x, $y) = $self->window_to_buffer_coords('widget', $x, $y);

	my $hovering  = $self->{hovering_over_link};
	my $link_data = $self->set_cursor_if_appropriate($x, $y);

	if ($hovering) { # was hovering
		if ($self->{hovering_over_link}) { # still hovering
			if ("$link_data" ne $self->{_last_link}) {
				$self->signal_emit('link_leave');
				$self->signal_emit('link_enter', $link_data);
				$self->{_last_link} = "$link_data";
			}
		}
		else { $self->signal_emit('link_leave') } # but not anymore
	}
	else { # was not hovering
		if ($self->{hovering_over_link}) { # but hovering now
			$self->signal_emit('link_enter', $link_data);
			$self->{_last_link} = "$link_data";
		}
	}
		
	return 0;
}

sub on_visibility_notify_event {
	# Update the cursor image if the window becomes visible
	# (e.g. when a window covering it got iconified).
	
	my $self = shift;
	$self->set_cursor_if_appropriate();
	return 0;
}

sub on_key_press_event {
	my ($self, $event) = @_;

	return 0 if $self->get_editable;

	my $val = $event->keyval();
	if (
		$val == $Gtk2::Gdk::Keysyms{KP_Enter} or
		$val == $Gtk2::Gdk::Keysyms{Return}
	) {
		my $buffer = $self->get_buffer;
		my $iter = $buffer->get_iter_at_mark($buffer->get_insert());
		$self->click_if_link_at_iter($iter);
	}
#	else { printf "key %x pressed\n", $val } # perldoc -m Gtk2::Gdk::Keysyms
	
	return 0;
}

sub on_button_release_event {
	# after button press

	my ($self, $event) = @_;
	return if $event->type ne 'button-release';

	# return if user made a selection
	my ($start, $end) = $self->get_buffer->get_selection_bounds;
	return if $start && $end and $start->get_offset != $end->get_offset;
	
	my ($x, $y) = $event->get_coords;
	   ($x, $y) = $self->window_to_buffer_coords('widget', $x, $y);
	my $iter = $self->get_iter_at_location($x, $y);

	$self->click_if_link_at_iter($iter);

	return 0;
}

1;

__END__

=head1 SIGNALS

=over 4

=item link_clicked

Link data as arg

=item link_enter

Link data as arg

=item link_leave

=back

= head2 sources

xfce-demo/hypertext.cc

PodViewer.pm

